!
!  phinit     Create structure of photometric FITS extensions
!
!  Copyright © 2010 - 2011 F.Hroch (hroch@physics.muni.cz)
!
!  This file is part of Munipack.
!
!  Munipack is free software: you can redistribute it and/or modify
!  it under the terms of the GNU General Public License as published by
!  the Free Software Foundation, either version 3 of the License, or
!  (at your option) any later version.
!  
!  Munipack is distributed in the hope that it will be useful,
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!  GNU General Public License for more details.
!  
!  You should have received a copy of the GNU General Public License
!  along with Munipack.  If not, see <http://www.gnu.org/licenses/>.


program phinit

  use ifits

  implicit none
  real, dimension(12) :: apertures
  real, dimension(2) :: ring
  character(len=1024) :: sb
  integer :: i

  forall( i = 1:size(apertures) )
     apertures(i) = 2.0*exp(0.1567271184*((i-1)*1.570796327))
     ! logarithmic spiral, pitch 8.9073 deg
  end forall
  ring = (/20.0, 30.0/)

  do
     read(*,*,end=20) sb

     call finit(sb,apertures,ring)

  end do

20 continue


!!$contains
!!$
!!$subroutine initph(filename,raper,ring)
!!$
!!$  implicit none
!!$
!!$  character(len=*),intent(in) :: filename
!!$  real, dimension(:),intent(in) :: raper,ring
!!$  integer :: status, blocksize
!!$  character(len=80) :: buf, label, label_err
!!$  character(len=80), dimension(11+2*size(raper)) :: ttype, tform, tunit
!!$  integer :: i,j
!!$
!!$  ttype(1) = 'x';            tform(1) = '1D';  tunit(1) = ''
!!$  ttype(2) = 'y';            tform(2) = '1D';  tunit(2) = ''
!!$  ttype(3) = 'sky';          tform(3) = '1D';  tunit(3) = ''
!!$  ttype(4) = 'sky_err';      tform(4) = '1D';  tunit(4) = ''
!!$  ttype(5) = 'peak_ratio';   tform(5) = '1D';  tunit(5) = ''
!!$  ttype(6) = 'apcflux';      tform(6) = '1D';  tunit(6) = ''
!!$  ttype(7) = 'apcflux_err';  tform(7) = '1D';  tunit(7) = ''
!!$  ttype(8) = 'psfflux';      tform(8) = '1D';  tunit(8) = ''
!!$  ttype(9) = 'psfflux_err';  tform(9) = '1D';  tunit(9) = ''
!!$  ttype(10) = 'psfpeak';     tform(10) = '1D'; tunit(10) = ''
!!$  ttype(11) = 'psfpeak_err'; tform(11) = '1D'; tunit(11) = ''
!!$
!!$  do i = 1, size(raper)
!!$
!!$     write(buf,'(i0)') i
!!$     label = 'apflux'//trim(buf)
!!$     label_err= trim(label)//'_err'
!!$     j = 10 + 2*i
!!$!     write(*,*) trim(label),' ',trim(label_err)
!!$     ttype(j)   = trim(label);     tform(j) = '1D';   tunit(j) = ''
!!$     ttype(j+1) = trim(label_err); tform(j+1) = '1D'; tunit(j+1) = ''
!!$
!!$  end do
!!$
!!$
!!$!  write(*,*) trim(filename)
!!$  
!!$  status = 0
!!$  call ftopen(15,filename,1,blocksize,status)
!!$!  call ftinit(16,'X'//filename,blocksize,status)
!!$
!!$
!!$!  call ftcpfl(15,16,1,1,1,status)
!!$
!!$
!!$  call ftibin(15,0,size(ttype),ttype,tform,tunit,'MUNIPHOT',0,status)
!!$
!!$  do i = 1, size(raper)
!!$     write(label,'(a,i0)') 'APER',i
!!$     call ftpkye(15,trim(label),raper(i),-5,'[pix] aperture radius',status)
!!$  end do
!!$
!!$  call ftpkye(15,'ANNULUS1',ring(1),-5,'[pix] inner sky annulus radius',status)
!!$  call ftpkye(15,'ANNULUS2',ring(2),-5,'[pix] outer sky annulus radius',status)
!!$
!!$!  FTPCL[SLBIJKEDCM](unit,colnum,frow,felem,nelements,values, > status)
!!$  call ftclos(15,status)
!!$!  CALL ftclos(16,status)
!!$
!!$  if( status /= 0 )then
!!$     write(*,*) 'FITSIO: following error(s) has been occured:'
!!$     do
!!$        Call ftgmsg(buf)
!!$        if( buf == ' ' ) exit
!!$        write(*,*) trim(buf)
!!$     enddo
!!$  endif
!!$
!!$
!!$end subroutine initph

end program phinit
